home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1093.ZIP / WINDOW40.ARC / WMGRDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1987-12-12  |  10KB  |  292 lines
  1. { =========================================================================== }
  2. { Wmgrdemo.pas - Random-access, multi-level window demo     ver 4.0, 12-12-87 }
  3. {                                                                             }
  4. { This program shows you how the window management utilities allow you to     }
  5. { access any window at any time.  You can even hide the top level window for  }
  6. { displaying later.                                                           }
  7. { =========================================================================== }
  8. { Run program.
  9.   To make any window come to the top, press the window number.
  10.   To move a window (only the top one), leave Scroll Lock on and press arrow
  11.     keys, including Home, End, PgDn, PgUp, ^Left-arrrow and ^Right-arrow.
  12.   To hide the top level window, press ESC.
  13.   To show a hidden window, just press the window number.
  14.   To quit, press F10. }
  15.  
  16. program WindowManager;
  17.  
  18. {$M 16384, 16384, 16384 }
  19. {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
  20.  
  21. uses Crt,Qwik,WndwVars,Wndw;
  22.  
  23. type
  24.   Str80 = string[80];
  25.  
  26. const
  27.   LArr     = #75;
  28.   RArr     = #77;
  29.   UArr     = #72;
  30.   DArr     = #80;
  31.   HomeKey  = #71;
  32.   EndKey   = #79;
  33.   PgUp     = #73;
  34.   PgDn     = #81;
  35.   CtrlLArr = #115;
  36.   CtrlRArr = #116;
  37.   EscKey   = #27;
  38.   RetKey   = #13;
  39.   NullKey  = #00;
  40.   F10Key   = #68;
  41.  
  42.   StrA: array[1..5] of Str80 = (
  43.     'FORMAT:  HideWindow;',
  44.     'This procedure simply  hides the',
  45.     'top level window from the screen',
  46.     'which can later be displayed un-',
  47.     'altered by ShowWindow.');
  48.  
  49.   StrB: array[1..4] of Str80 = (
  50.     'FORMAT:  ShowWindow (WindowName: WindowNames);',
  51.     'A hidden window can be redisplayed randomly to be',
  52.     'the new top level window.  Nothing happens if the',
  53.     'WindowName is not found among the hidden windows.');
  54.  
  55.   StrC: array[1..7] of Str80 = (
  56.     'FORMAT:  MoveWindow (Dir: DirType; NumOfChars: byte);',
  57.     'The top level window can be moved in any direction and',
  58.     'the number of characters  (i.e, rows or cols) can also',
  59.     'specified.   This gives  full rate control.  This even',
  60.     'lets you  push a window  to its margin  limits without',
  61.     'calculation.  Try ^Left-arrow, ^Right-arrow, PgUp, and',
  62.     'PgDn.  Shadows are also accommodated.');
  63.  
  64.   StrD: array[1..5] of Str80 = (
  65.     'FORMAT:  AccessWindow (WindowName: WindowNames);',
  66.     'To bring a window to the top level, whether hidden',
  67.     'or not, use AccessWindow.  All windows are totally',
  68.     'managed and fluid.  Shadows are permitted, but not',
  69.     'fully supported.');
  70.  
  71.   StrE: array[1..5] of Str80 = (
  72.     'FORMAT:  Attr (Foreground,Background: byte);',
  73.     'This is a trivial function that simply con-',
  74.     'verts the colors to a byte.  However, it is',
  75.     'recommended that you use the new background',
  76.     'constants instead.  See WNDWVARS.PAS.');
  77.  
  78.   StrF: array[1..6] of Str80 = (
  79.     'FORMAT: RestoreTurboWindow;',
  80.     'If for some reason you jump',
  81.     'out of a  window,  this one',
  82.     'will  restore  Turbo window',
  83.     'text colors, window limits,',
  84.     'and cursor position.');
  85.  
  86.   StrG: array[1..4] of Str80 = (
  87.     'FORMAT:  HeapOK (NumOfBytes: word);',
  88.     'This function returns true if NumOfBytes',
  89.     'is available on the Heap.  An error mes-',
  90.     'sage is flashed on the screen otherwise.');
  91.  
  92.   StrH: array[1..5] of Str80 = (
  93.     'FORMAT:  Qbox (Row,Col,Rows,Cols: byte;',
  94.     '               Wattr,Battr: integer;',
  95.     '               BorderSel: Borders);',
  96.     'Qbox is a subroutine of  MakeWindow that',
  97.     'simply overwrites the screen with a box.');
  98.  
  99.   StrI: array[1..4] of Str80 = (
  100.     'FORMAT:  GetLevelIndex (WindowName: WindowNames);',
  101.     'This  function searches  the displayed and then the',
  102.     'hidden  WndwStats  for  the  first  level  matching',
  103.     'WindowName.  Zero is returned if no match is found.');
  104.  
  105. var
  106.   Key:          char;
  107.   ExtKey:       boolean;
  108.   ClockReading: longint absolute $0040:$006C; { low memory clock }
  109.   TimeAtKbd1:   longint;
  110.   RowStep,ColStep,FastRowStep,FastColStep,
  111.   i,TypematicRate,IdleTime:  byte;
  112.  
  113. procedure DisableInterrupts; inline($FA);  { CLI }
  114. procedure EnableInterrupts;  inline($FB);  { STI }
  115.  
  116. procedure ReadKbd (VAR ExtKey: boolean; VAR Key: char);
  117. begin
  118.   Key:=ReadKey;                          { Read keyboard input.       }
  119.   if KeyPressed and (Key=NullKey) then   { If first Char was null ... }
  120.     begin
  121.       Key:=ReadKey;                      { ... read second char.      }
  122.       ExtKey := true
  123.     end
  124.   else ExtKey:=false;
  125. end;
  126.  
  127. function ScrollLockOn: boolean;
  128. var  KeyStat: byte absolute $0000:$0417;
  129. begin
  130.   ScrollLockOn:=((KeyStat and $10)<>0);  { True if bit 4 set. }
  131. end;
  132.  
  133. procedure InitStepRates;
  134. begin
  135.   TypematicRate:=1;    { A maximum of 1 clock tick indicates typematic rate }
  136.   if CRTrows>40 then
  137.        FastRowStep:=4
  138.   else FastRowStep:=2;
  139.   FastColStep:=CRTcols div 20;
  140. end;
  141.  
  142. procedure SetStartTime;
  143. begin
  144.   DisableInterrupts;
  145.   TimeAtKbd1:=ClockReading;
  146.   EnableInterrupts;
  147. end;
  148.  
  149. procedure AdjustStepRates;
  150. begin
  151.   DisableInterrupts;
  152.   IdleTime:=ClockReading-TimeAtKbd1;
  153.   EnableInterrupts;
  154.   if IdleTime<=TypematicRate then
  155.     begin
  156.       ColStep:=FastColStep;
  157.       RowStep:=FastRowStep;
  158.     end
  159.   else
  160.     begin
  161.       ColStep:=1;
  162.       RowStep:=1;
  163.     end;
  164. end;
  165.  
  166. begin
  167.   InitWindow (yellow+BlackBG,true);
  168.   InitStepRates;
  169.   SetWindowModes (ZoomMode);
  170.  
  171.   MakeWindow ( 1, 2,10,36,black+BrownBG,black+BrownBG,SingleBrdr,Window1);
  172.   TitleWindow (Top,Left,' 1 HideWindow ');
  173.   with TopWndwStat do
  174.     begin
  175.                        Qwrite (WSrow+2  ,WScol+2,-1,StrA[1]);
  176.       for i:=2 to 5 do Qwrite (WSrow+2+i,WScol+2,-1,StrA[i]);
  177.       GotoRC (pred(WSrow2),WSwhereC);
  178.     end;
  179.  
  180.   MakeWindow ( 3,15, 9,53,black+LightGrayBG,black+LightGrayBG,DoubleBrdr,
  181.               Window2);
  182.   TitleWindow (Top,Left,' 2 ShowWindow ');
  183.   with TopWndwStat do
  184.     begin
  185.                        Qwrite (WSrow+2  ,WScol+2,-1,StrB[1]);
  186.       for i:=2 to 4 do Qwrite (WSrow+2+i,WScol+2,-1,StrB[i]);
  187.       GotoRC (pred(WSrow2),WSwhereC);
  188.     end;
  189.  
  190.   MakeWindow ( 4, 5,12,58,lightred+BlackBG,lightred+BlackBG,HdoubleBrdr,
  191.                Window3);
  192.   TitleWindow (Top,Left,' 3 MoveWindow ');
  193.   with TopWndwStat do
  194.     begin
  195.                        Qwrite (WSrow+2  ,WScol+2,-1,StrC[1]);
  196.       for i:=2 to 7 do Qwrite (WSrow+2+i,WScol+2,-1,StrC[i]);
  197.       GotoRC (pred(WSrow2),WSwhereC);
  198.     end;
  199.  
  200.   MakeWindow ( 6, 9,10,54,white+CyanBG,white+CyanBG,SolidBrdr,Window4);
  201.   TitleWindow (Top,Left,' 4 AccessWindow ');
  202.   with TopWndwStat do
  203.     begin
  204.                        Qwrite (WSrow+2  ,WScol+2,-1,StrD[1]);
  205.       for i:=2 to 5 do Qwrite (WSrow+2+i,WScol+2,-1,StrD[i]);
  206.       GotoRC (pred(WSrow2),WSwhereC);
  207.     end;
  208.  
  209.   MakeWindow ( 8, 7,10,48,yellow+GreenBG,yellow+GreenBG,EvenSolidBrdr,Window5);
  210.   TitleWindow (Top,Left,' 5 Attr ');
  211.   with TopWndwStat do
  212.     begin
  213.                        Qwrite (WSrow+2  ,WScol+2,-1,StrE[1]);
  214.       for i:=2 to 5 do Qwrite (WSrow+2+i,WScol+2,-1,StrE[i]);
  215.       GotoRC (pred(WSrow2),WSwhereC);
  216.     end;
  217.  
  218.   MakeWindow (14, 1,11,31,white+BlueBG,white+BlueBG,ThinSolidBrdr2,Window6);
  219.   TitleWindow (Top,Left,' 6 RestoreTurboWindow ');
  220.   with TopWndwStat do
  221.     begin
  222.                        Qwrite (WSrow+2  ,WScol+2,-1,StrF[1]);
  223.       for i:=2 to 6 do Qwrite (WSrow+2+i,WScol+2,-1,StrF[i]);
  224.       GotoRC (pred(WSrow2),WSwhereC);
  225.     end;
  226.  
  227.   MakeWindow ( 5,37, 9,44,white+MagentaBG,White+MagentaBG,VdoubleBrdr,Window7);
  228.   TitleWindow (Top,Left,' 7 HeapOK ');
  229.   with TopWndwStat do
  230.     begin
  231.                        Qwrite (WSrow+2  ,WScol+2,-1,StrG[1]);
  232.       for i:=2 to 4 do Qwrite (WSrow+2+i,WScol+2,-1,StrG[i]);
  233.       GotoRC (pred(WSrow2),WSwhereC);
  234.     end;
  235.  
  236.   MakeWindow ( 7,33,10,44,yellow+RedBG,yellow+RedBG,MhatchBrdr,Window8);
  237.   TitleWindow (Top,Left,' 8 Qbox ');
  238.   with TopWndwStat do
  239.     begin
  240.       for i:=1 to 3 do Qwrite (WSrow+1+i,WScol+2,-1,StrH[i]);
  241.       for i:=4 to 5 do Qwrite (WSrow+2+i,WScol+2,-1,StrH[i]);
  242.       GotoRC (pred(WSrow2),WSwhereC);
  243.     end;
  244.  
  245.   MakeWindow ( 9,31,17,41,white+CyanBG,white+CyanBG,HdoubleBrdr,Window9);
  246.   TitleWindow (Top,Left,' 9 Demo Instructions ');
  247.   with TopWndwStat do
  248.     begin
  249.       QwriteC (WSrow+2,WScol,WScol2,-1,'READ FIRST !');
  250.       Qwrite  (WSrow+4,WSwhereC,-1,'Press 1 - 9 to bring that number window');
  251.       Qwrite  (WSrow+5,WSwhereC,-1,'to the top.  Press ESC to  hide the top');
  252.       Qwrite  (WSrow+6,WSwhereC,-1,'window.');
  253.       Qwrite  (WSrow+8,WSwhereC,-1,'Press Scroll Lock  on and  use all  the');
  254.       Qwrite  (WSrow+9,WSwhereC,-1,'cursor keys to move top window around.');
  255.       Qwrite  (WSrow+10,WSwhereC,-1,'Or type any key into the window.');
  256.       Qwrite  (WSrow+12,WSwhereC,-1,'Press F10 to quit.');
  257.       Qwrite  (WSrow+14,WSwhereC,-1,'Zoom mode is on for all windows.');
  258.       GotoRC  (pred(WSrow2),WSwhereC);
  259.     end;
  260.   repeat
  261.     SetStartTime;
  262.     ReadKbd (ExtKey,Key);
  263.     if ExtKey then
  264.       begin
  265.         if ScrollLockOn then
  266.           begin
  267.             AdjustStepRates;
  268.             case Key of
  269.               UArr:         MoveWindow (Up   ,RowStep);
  270.               PgUp,HomeKey: MoveWindow (Up   ,CRTrows);
  271.               DArr:         MoveWindow (Down ,RowStep);
  272.               PgDn,EndKey:  MoveWindow (Down ,CRTrows);
  273.               LArr:         MoveWindow (Left ,ColStep);
  274.               CtrlLArr:     MoveWindow (Left ,CRTcols);
  275.               RArr:         MoveWindow (Right,ColStep);
  276.               CtrlRArr:     MoveWindow (Right,CRTcols);
  277.             end
  278.           end
  279.       end
  280.     else
  281.       case Key of
  282.         '1'..'9':  AccessWindow (WindowNames(ord(Key)-ord('0')));
  283.         EscKey:    if (LI>0) then HideWindow;
  284.         RetKey:    writeln;
  285.         #32..#126: write (Key);
  286.       end;
  287.   until ExtKey and (Key=F10Key);
  288.  
  289.   for i:=1 to LI do RemoveWindow;  { Not necessary, but it's orderly. }
  290.   ClrScr;
  291. end.
  292.